home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / 173c_bas.zip / SOURCE / RBBSSUB1.BAS < prev    next >
BASIC Source File  |  1991-09-01  |  54KB  |  1,675 lines
  1. ' $linesize:132
  2. ' $title: 'RBBS-SUB1.BAS 17.3C, Copyright 1986-91 by D. Thomas Mack'
  3. '  Copyright 1991 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB1.BAS
  5. '  First Released .....: February 11, 1990
  6. '  Subsequent Releases.: August 26, 1990; October 28, 1990; Sept 1, 1991
  7. '  Copyright ..........: 1986-1991
  8. '  Purpose.............:
  9. '     Subprorams that require error trapping are incorporated
  10. '     within RBBSSUB1.BAS as separately callable subroutines
  11. '     in order to free up as much code as possible within
  12. '     the 64WasK code segment used by RBBS-PC.BAS.
  13. '  Parameters..........: Most parameters are passed via a COMMON statement.
  14. '
  15. ' Subroutine  Line               Function of Subroutine
  16. '   Name     Number
  17. '  ChangeDir   20101   Change subdirectory
  18. '  CheckInt    58360   Check input is valid integer
  19. '  CommPut     59275   Write string to communications port
  20. '  FindFile    59790   Determine whether a file exists without opening it
  21. '  FindFree    51098   Find amount of space on the upload disk drive
  22. '  FindItX     20219   Find if a file exists on a device
  23. '  FindUser    12598   Find a user in the USERS file
  24. '  FlushCom    20308   Read all characters in the communications port
  25. '  GetCom       1418   Read a character from the communications port
  26. '  GetPassword 58280   Read RBBS-PC's "PASSWORD" file
  27. '  GETWRK      58330   Read record from file number 2
  28. '  KillWork    58258   Delete a RBBS-PC "WORK" file
  29. '  NetBIOS     20898   Lock/Unlock NetBIOS semaphore files
  30. '  OpenCom       200   Open communications port (number 3)
  31. '  OpenFMS     58188   Open the upload management system directory
  32. '  OpenOutW    28218   Open RBBS-PC's "WORK" file (number 2) for output
  33. '  OpenRSeq     1479   Open a sequential file (number 2) for random I/O
  34. '  OpenUser     9398   Open the USER file (number 5)
  35. '  OpenWork    57978   Open RBBS-PC's work file (number 2)
  36. '  OpenWorkA   58340   Open RBBS-PC's "WORK" file (number 2) for append
  37. '  Printit     13673   Print line on the local PC printer
  38. '  PrintWork   58320   Print string to file #2 w/o CR/LF
  39. '  PrintWorkA  58350   Print string to file #2 with CR/LF
  40. '  PutCom      59650   Write to the communications port
  41. '  PutWork     59660   Write to work file randomly
  42. '  RBBSPlay    59680   Plays a musical string
  43. '  ReadAny     58310   Read file number 2 into ZOutTxt$
  44. '  ReadDef       112   Read configuration file
  45. '  ReadDir     58290   Read entire lines
  46. '  ReadParms   58300   Read certain number of parameters from file 2
  47. '  Talk        59700   RBBS-PC Voice synthesizer support for sight impaired
  48. '  SetCall       108   Find where next callers record is
  49. '  UpdateC     43048   Update the caller's file with elasped session time
  50. '  UpdtCalr    13661   Update to the caller's file
  51. '
  52. '  $INCLUDE: 'RBBS-VAR.BAS'
  53. '
  54. 108 ' $SUBTITLE: 'SetCall - subroutine to find last callers rec'
  55. ' $PAGE
  56. '
  57. '  NAME    -- SetCall
  58. '
  59. '  INPUTS  --     PARAMETER                    MEANING
  60. '
  61. '  OUTPUTS --  ZCallersFileIndex!
  62. '
  63. '  PURPOSE --  To find where to leave off on callers file
  64. '
  65.     SUB SetCall STATIC
  66.     ON ERROR GOTO 65000
  67.     IF ZPrevCaller$ = ZCallersFile$ OR ZCallersFilePrefix$ = "" THEN _
  68.        EXIT SUB
  69.     ZPrevCaller$ = ZCallersFile$
  70.     ZCallersFileIndex! = 1
  71.     CLOSE 2
  72.     CLOSE 4
  73.     IF ZShareIt THEN _
  74.        OPEN ZCallersFile$ FOR RANDOM SHARED AS #4 LEN=64 _
  75.     ELSE OPEN "R",4,ZCallersFile$,64
  76.     FIELD 4,64 AS ZCallersRecord$
  77.     IF LOF(4) > 0 THEN _
  78.        ZCallersFileIndex! = LOF(4) / 64
  79.     IF ZCallersFileIndex! < 1 THEN _
  80.        ZCallersFileIndex! = 0
  81.     ZUserIn$ = STRING$(13,0)
  82. 110 GET 4,ZCallersFileIndex!
  83.     IF ZErrCode > 0 THEN _
  84.        ZErrCode = 0 : _
  85.        ZCallersFileIndex! = 0 : _
  86.        EXIT SUB
  87.     IF LEFT$(ZCallersRecord$,13) = ZUserIn$ THEN _
  88.        ZCallersFileIndex! = ZCallersFileIndex! - 1 : _
  89.        GOTO 110
  90.     END SUB
  91. 112 ' $SUBTITLE: 'ReadDef - subroutine to read RBBS-PC.DEF file'
  92. ' $PAGE
  93. '
  94. '  NAME    -- ReadDef
  95. '
  96. '  INPUTS  --     PARAMETER                    MEANING
  97. '                ZConfigFileName$            NAME OF RBBS-PC.DEF FILE
  98. '                ZSubParm = -62              ONLY READ THE .DEF FILE
  99. '
  100. '  OUTPUTS --  ALL THE RBBS-PC.DEF PARAMETERS
  101. '
  102. '  PURPOSE --  TO READ THE PARAMETERS FROM THE RBBS-PC.DEF FILE
  103. '
  104.      SUB ReadDef (ConfigFile$) STATIC
  105.      ON ERROR GOTO 65000
  106. '
  107. ' **** OPEN AND READ RBBS-PC CONFIGURATION DEFINITIONS ***
  108. '
  109. 117 IF ZSubParm <> -62 THEN _
  110.        IF PrevRead$ = ConfigFile$ THEN _
  111.           EXIT SUB _
  112.        ELSE PrevRead$ = ConfigFile$
  113.     CLOSE 2
  114.     ZBulletinSave$ = ZBulletinMenu$
  115.     CALL OpenWork (2,ConfigFile$)
  116.     ZCurDef$ = ConfigFile$
  117.     INPUT #2,ZWasDF$, _
  118.              ZDnldDrives$, _
  119.              ZSysopPswd1$, _
  120.              ZSysopPswd2$, _
  121.              ZSysopFirstName$, _
  122.              ZSysopLastName$, _
  123.              ZRequiredRings, _
  124.              ZStartOfficeHours, _
  125.              ZEndOfficeHours, _
  126.              ZMinsPerSession, _
  127.              ZWasDF, _
  128.              ZWasDF, _
  129.              ZUpldDir$, _
  130.              ZExpertUserDef, _
  131.              ZActiveBulletins, _
  132.              ZPromptBellDef, _
  133.              ZWasDF, _
  134.              ZMenusCanPause, _
  135.              ZMenu$(1), _
  136.              ZMenu$(2), _
  137.              ZMenu$(3), _
  138.              ZMenu$(4), _
  139.              ZMenu$(5), _
  140.              ZMenu$(6), _
  141.              ZConfMenu$, _
  142.              ZWasDF, _
  143.              ZWelcomeInterruptable, _
  144.              ZRemindFileXfers, _
  145.              ZPageLengthDef, _
  146.              ZMaxMsgLinesDef, _
  147.              ZDoorsAvail, _
  148.              ZWasDF$, _
  149.              ZMainMsgFile$, _
  150.              ZMainMsgBackup$
  151.     INPUT #2, WasX$, _
  152.               ZCmntsFile$, _
  153.               ZMainUserFile$, _
  154.               ZWelcomeFile$, _
  155.               ZNewUserFile$, _
  156.               ZMainDirExtension$
  157.     CALL BreakFileName (WasX$,ZWasY$,ZWasDF$,ZWasZ$,ZFalse)
  158.     IF ZWasDF$ <> "" THEN _
  159.        ZCallersFile$ = WasX$
  160.     INPUT #2, ZWasDF$
  161.     IF ZComPort$ <> "COM0" THEN _
  162.        IF NOT ZConfMode THEN _
  163.           ZComPort$ = ZWasDF$
  164.     INPUT #2, ZBulletinsOptional, _
  165.               ZModemInitCmd$, _
  166.               ZRTS$, _
  167.               ZWasDF, _
  168.               ZFG, _
  169.               ZBG, _
  170.               ZBorder
  171.     IF ZConfMode THEN _
  172.        INPUT #2, ZWasDF$, _
  173.                  ZWasDF$ _
  174.     ELSE INPUT #2, ZRBBSBat$ , _
  175.                    ZRCTTYBat$
  176.     INPUT #2,ZOmitMainDir$, _
  177.              ZFirstNamePrompt$, _
  178.              ZHelp$(3), _
  179.              ZHelp$(4), _
  180.              ZHelp$(7), _
  181.              ZHelp$(9), _
  182.              ZBulletinMenu$, _
  183.              ZBulletinPrefix$, _
  184.              ZWasDF$, _
  185.              ZMsgReminder, _
  186.              ZRequireNonASCII, _
  187.              ZAskExtendedDesc, _
  188.              ZMaxNodes, _
  189.              ZNetworkType
  190.     IF ZConfMode THEN _
  191.          INPUT #2, ZwasDF _
  192.     ELSE INPUT #2, ZRecycleToDos
  193.     INPUT #2,ZWasDF, _
  194.              ZWasDF, _
  195.              ZTrashcanFile$
  196.     INPUT #2,ZMinLogonSec, _
  197.              ZDefaultSecLevel, _
  198.              ZSysopSecLevel, _
  199.              ZFileSecFile$, _
  200.              ZSysopMenuSecLevel, _
  201.              ZConfMailList$, _
  202.              ZMaxViolations, _
  203.              ZOptSec(50), _   ' SECURITY FOR SYSOP COMMANDS 1
  204.              ZOptSec(51), _
  205.              ZOptSec(52), _
  206.              ZOptSec(53), _
  207.              ZOptSec(54), _
  208.              ZOptSec(55), _
  209.              ZOptSec(56), _   ' SYSOP 7
  210.              ZPswdFile$, _
  211.              ZMaxPswdChanges, _
  212.              ZMinSecForTempPswd, _
  213.              ZOverWriteSecLevel, _
  214.              ZDoorsTermType, _
  215.              ZMaxPerDay
  216.     INPUT #2,ZOptSec(1), _   ' SECURITY FOR MAIN MENU COMMANDS 1
  217.              ZOptSec(2), _
  218.              ZOptSec(3), _
  219.              ZOptSec(4), _
  220.              ZOptSec(5), _
  221.              ZOptSec(6), _
  222.              ZOptSec(7), _
  223.              ZOptSec(8), _
  224.              ZOptSec(9), _
  225.              ZOptSec(10), _
  226.              ZOptSec(11), _
  227.              ZOptSec(12), _
  228.              ZOptSec(13), _
  229.              ZOptSec(14), _
  230.              ZOptSec(15), _
  231.              ZOptSec(16), _
  232.              ZOptSec(17), _
  233.              ZOptSec(18), _   ' MAIN COMMAND 18
  234.              ZMinNewCallerBaud, _
  235.              ZWaitBeforeDisconnect
  236.     INPUT #2,ZOptSec(19), _      ' Security for FILE COMMANDS 1
  237.              ZOptSec(20), _
  238.              ZOptSec(21), _
  239.              ZOptSec(22), _
  240.              ZOptSec(23), _
  241.              ZOptSec(24), _
  242.              ZOptSec(25), _
  243.              ZOptSec(26), _      ' FILE COMMAND 8
  244.              ZOptSec(27), _      ' SECURITY FOR UTILITY COMMANDS 1
  245.              ZOptSec(28), _
  246.              ZOptSec(29), _
  247.              ZOptSec(30), _
  248.              ZOptSec(31), _
  249.              ZOptSec(32), _
  250.              ZOptSec(33), _
  251.              ZOptSec(34), _
  252.              ZOptSec(35), _
  253.              ZOptSec(36), _
  254.              ZOptSec(37), _
  255.              ZOptSec(38), _   ' UTIL COMMAND 12
  256.              ZOptSec(46), _   ' SECURITY FOR GLOBAL COMMANDS 1
  257.              ZOptSec(47), _
  258.              ZOptSec(48), _
  259.              ZOptSec(49), _
  260.              ZUpldTimeFactor!, _
  261.              ZComputerType, _
  262.              ZRemindProfile, _
  263.              ZRBBSName$, _
  264.              ZCmdsBetweenRings, _
  265.              ZMNPSupport, _
  266.              ZPagingPtrSupport$
  267.     IF ZConfMode THEN _
  268.          INPUT #2, ZwasDF _
  269.     ELSE INPUT #2, ZModemInitBaud$
  270.              IF ZErrCode > 0 THEN _
  271.                 EXIT SUB
  272. 118 INPUT #2, ZTurnPrinterOff,_    ' Turn printer off each recycle
  273.               ZDirPath$, _    ' Where dir files are stored
  274.               ZMinSecToView, _
  275.               ZLimitSearchToFMS, _
  276.               ZDefaultCatCode$, _
  277.               ZDirCatFile$, _
  278.               ZNewFilesCheck, _
  279.               ZMaxDescLen, _
  280.               ZShowSection, _
  281.               ZCmndsInPrompt, _
  282.               ZNewUserSetsDefaults, _
  283.               ZHelpPath$, _
  284.               ZHelpExtension$, _
  285.               ZMainCmds$, _
  286.               ZFileCmd$, _
  287.               ZUtilCmds$, _
  288.               ZGlobalCmnds$, _
  289.               ZSysopCmds$
  290.     INPUT #2, ZRecycleWait, _
  291.               ZOptSec(39), _       ' SECURITY FOR Library COMMANDS 1
  292.               ZOptSec(40), _
  293.               ZOptSec(41), _
  294.               ZOptSec(42), _
  295.               ZOptSec(43), _
  296.               ZOptSec(44), _
  297.               ZOptSec(45), _       ' Library COMMANDS 7
  298.               ZLibDrive$, _
  299.               ZLibDirPath$, _
  300.               ZLibDirExtension$, _
  301.               ZLibWorkDiskPath$, _
  302.               ZLibMaxDisk, _
  303.               ZLibMaxDir, _
  304.               ZLibMaxSubdir, _
  305.               ZLibSubdirPrefix$, _
  306.               ZLibArcPath$, _
  307.               ZLibArcProgram$, _
  308.               ZLibCmds$
  309. '
  310. ' *****  ESTABLISH COMMUNICATION PORT REGISTERS AND COMMANDS   ***
  311. ' *****     GET DOS SUB-DIRECTORY RBBS-PC OPTIONS              ***
  312. '
  313.     INPUT #2, ZUpldPath$, _              ' Where upl dir goes
  314.               ZMainFMSDir$, _       ' Shared dir in FMS
  315.               ZAnsMenu$, _
  316.               ZReqQues$,_
  317.               ZRememberNewUsers,_
  318.               ZSurviveNoUserRoom,_
  319.               ZPromptHash$,_
  320.               ZStartHash,_
  321.               ZLenHash,_
  322.               ZPromptIndiv$,_
  323.               ZStartIndiv,_
  324.               ZLenIndiv
  325.     INPUT #2, ZBypassMsgs, _
  326.               ZMusic, _
  327.               ZRestrictByDate, _
  328.               ZDaysToWarn, _
  329.               ZDaysInRegPeriod, _
  330.               ZVoiceType, _
  331.               ZRestrictValidCmds, _
  332.               ZNewUserDefaultMode, _
  333.               ZNewUserLineFeeds, _
  334.               ZNewUserNulls, _
  335.               ZFastFileList$, _
  336.               ZFastFileLocator$, _
  337.               ZMsgsCanGrow, _
  338.               ZWrapCallersFile$, _
  339.               ZRedirectIOMethod, _
  340.               ZAutoUpgradeSec, _
  341.               ZHaltOnError, _
  342.               ZNewPublicMsgsSec, _
  343.               ZNewPrivateMsgsSec, _
  344.               SecNeededToChangeMsgs, _
  345.               ZSLCategorizeUplds, _
  346.               ZNoQuoting, _
  347.               ZHourMinToDropToDos, _
  348.               ZExpiredSec, _
  349.               ZDTRDropDelay, _
  350.               ZAskID, _
  351.               ZMaxRegSec, _
  352.               ZBufferSize, _
  353.               ZMLCom, _
  354.               ZNoDoorProtect, _
  355.               ZDefaultExtension$, _
  356.               ZNewUserDefaultProtocol$, _
  357.               ZNewUserGraphics$, _
  358.               ZNetMail$, _
  359.               ZMasterDirName$, _
  360.               ZProtoDef$, _
  361.               ZUpcatHelp$, _
  362.               ZAllwaysStrewTo$, _
  363.               ZLastNamePrompt$
  364. 119 INPUT #2, ZPersonalDrvPath$, _
  365.               ZPersonalDir$, _
  366.               ZPersonalBegin, _
  367.               ZPersonalLen, _
  368.               ZPersonalProtocol$, _
  369.               ZPersonalConcat , _
  370.               ZPrivateReadSec, _
  371.               ZPublicReadSec, _
  372.               ZSecChangeMsg
  373.     IF ZConfMode THEN _
  374.          INPUT #2, ZwasDF _
  375.     ELSE INPUT #2, ZKeepInitBaud
  376.     INPUT #2, ZMainPUI$
  377.     IF ZConfMode THEN _
  378.        INPUT #2, ZWasDF$,ZWasDF$,ZWasDF$ _
  379.     ELSE INPUT #2, ZDefaultEchoer$, _
  380.                    ZHostEchoOn$, _
  381.                    ZHostEchoOff$
  382.     INPUT #2, ZSwitchBack, _
  383.               ZDefaultLineACK$, _
  384.               ZAltdirExtension$, _
  385.               ZDirPrefix$
  386.     IF ZConfMode THEN _
  387.        INPUT #2, ZWasDF, _
  388.                  ZWasDF, _
  389.                  ZWasDF _
  390.     ELSE INPUT #2, ZWasDF,_
  391.                    ZModemInitWaitTime, _
  392.                    ZModemCmdDelayTime
  393.     INPUT #2, ZTurboRBBS, _
  394.               ZSubDirCount, _
  395.               ZWasDF, _
  396.               ZUpldToSubdir, _
  397.               ZWasDF, _
  398.               ZUpldSubdir$, _
  399.               ZMinOldCallerBaud, _
  400.               ZMaxWorkVar, _
  401.               ZDiskFullGoOffline, _
  402.               ZExtendedLogging
  403.      IF ZConfMode THEN _
  404.         INPUT #2, ZWasDF$, _
  405.                   ZWasDF$, _
  406.                   ZWasDF$, _
  407.                   ZWasDF$ _
  408.      ELSE INPUT #2, ZModemResetCmd$, _
  409.                     ZModemCountRingsCmd$, _
  410.                     ZModemAnswerCmd$, _
  411.                     ZModemGoOffHookCmd$
  412.      INPUT #2,ZDiskForDos$, _
  413.               ZDumbModem, _
  414.               ZCmntsAsMsgs
  415.      IF ZConfMode THEN _
  416.         INPUT #2, ZWasDF, _
  417.                   ZWasDF, _
  418.                   ZWasDF, _
  419.                   ZWasDF, _
  420.                   ZWasDF, _
  421.                   ZWasDF _
  422.      ELSE INPUT #2, ZLSB,_
  423.                     ZMSB,_
  424.                     ZLineCntlReg,_
  425.                     ZModemCntlReg,_
  426.                     ZLineStatusReg,_
  427.                     ZModemStatusReg
  428.      INPUT #2,ZKeepTimeCredits, _
  429.               ZXOnXOff, _
  430.               ZAllowCallerTurbo, _
  431.               ZUseDeviceDriver$, _
  432.               ZPreLog$, _
  433.               ZNewUserQuestionnaire$, _
  434.               ZEpilog$, _
  435.               ZRegProgram$, _
  436.               ZQuesPath$, _
  437.               ZUserLocation$, _
  438.               ZWasDF$, _
  439.               ZWasDF$, _
  440.               ZWasDF$, _
  441.               ZEnforceRatios, _
  442.               ZSizeOfStack, _
  443.               ZSecExemptFromEpilog, _
  444.               ZUseBASICWrites, _
  445.               ZDosANSI, _
  446.               ZEscapeInsecure, _
  447.               ZUseDirOrder, _
  448.               ZAddDirSecurity, _
  449.               ZMaxExtendedLines, _
  450.               ZOrigCommands$
  451.      INPUT #2,ZLogonMailLevel$, _
  452.               ZMacroDrvPath$, _
  453.               ZMacroExtension$, _
  454.               ZEmphasizeOnDef$, _
  455.               ZEmphasizeOffDef$, _
  456.               ZFG1Def$, _
  457.               ZFG2Def$, _
  458.               ZFG3Def$, _
  459.               ZFG4Def$, _
  460.               ZSecVioHelp$
  461.      IF ZConfMode THEN _
  462.         INPUT #2,ZWasDF _
  463.      ELSE INPUT #2,ZFossil
  464.      INPUT #2,ZMaxCarrierWait, _
  465.               ZWasDF, _
  466.               ZSmartTextCode, _
  467.               ZTimeLock, _
  468.               ZWriteBufDef, _
  469.               ZSecKillAny, _
  470.               ZDoorsDef$, _
  471.               ZScreenOutMsg$, _
  472.               ZAutoPageDef$
  473.      IF ZErrCode > 0 THEN _
  474.         EXIT SUB
  475.      ZConfigFileName$ = ConfigFile$
  476.      CALL EditDef
  477.      END SUB
  478. 200 ' $SUBTITLE: 'OpenCom - subroutine to open the communications port'
  479. ' $PAGE
  480. '
  481. '  NAME    -- OpenCom
  482. '
  483. '  INPUTS  --     PARAMETER                    MEANING
  484. '                BaudRate$                  BAUD TO OPEN MODEM
  485. '                Parity$                    PARITY TO OPEN MODEM
  486. '
  487. '  OUTPUTS -- BaudTest!                     BAUD RATE TO SET RS232 AT
  488. '
  489. '  PURPOSE -- To open the communications port.
  490. '
  491.     SUB OpenCom (BaudRate$,Parity$) STATIC
  492.     ON ERROR GOTO 65000
  493.     IF ZFossil THEN _
  494.        IF ZRTS$ = "YES" THEN _
  495.           ZFlowControl = ZTrue : _
  496.           Flow = &H00F2 : _
  497.           CALL FosFlowCtl(ZComPort,Flow)
  498.     IF INSTR(Parity$,"N") THEN _
  499.        Parity = 2 : _                                     ' No PARITY
  500.        DataBits = 3 : _                                   ' 8 DATA BITS
  501.        StopBits = 0 _                                     ' 1 STOP BIT
  502.     ELSE Parity = 3 : _                                   ' EVEN PARITY
  503.          DataBits = 2 : _                                 ' 7 DATA BITS
  504.          StopBits = 0                                     ' 1 STOP BIT
  505.     IF NOT ZFossil THEN _
  506.        GOTO 202
  507.     IF Baudrate$ = "38400" THEN _
  508.        ComSpeed = &H9600 _
  509.     ELSE ComSpeed = VAL(BaudRate$)
  510.     CALL FosSpeed(ZComPort,ComSpeed,Parity,DataBits,StopBits)
  511.     EXIT SUB
  512. 202 CLOSE 3
  513.     IF ZRTS$ = "YES" THEN _
  514.        ZFlowControl = ZTrue : _
  515.        WasX$ = ",CS26600,CD,DS" _
  516.     ELSE WasX$ = ",RS,CD,DS"
  517.     WasX = (VAL(BaudRate$) > 19200)
  518.     IF WasX THEN _
  519.        ZWasY$ = "19200" _
  520.     ELSE ZWasY$ = BaudRate$
  521.     OPEN ZComPort$ + ":" + ZWasY$ + Parity$ + WasX$ AS #3
  522. '
  523. ' ****************************************************************************
  524. ' *  RAISE THE RTS SIGNAL IF THE MODEM USES RTS FOR MODEM FLOW CONTROL (ONCE
  525. ' *  IT IS RAISED, IT WILL STAY UP UNTIL THE REGISTER IS CLEARED OUT).
  526. ' ****************************************************************************
  527. '
  528.     END SUB
  529. 1418 ' $SUBTITLE: 'GetCom -- subroutine reads a char. from  comm. port'
  530. ' $PAGE
  531. '
  532. '  NAME    -- GetCom
  533. '
  534. '  INPUTS  --   PARAMETER     MEANING
  535. '                 Strng$       STRING TO READ A CHARACTER INTO FROM
  536. '                              THE COMMUNICATIONS PORT (FILE #3)
  537. '
  538. '  OUTPUTS --   Strng$
  539. '
  540. '  PURPOSE -- Reads a character from the communications port.
  541. '
  542.      SUB GetCom (Strng$) STATIC
  543.      ON ERROR GOTO 65000
  544. 1420 IF ZFOSSIL THEN _
  545.         CALL FOSRXChar(ZComPort,Char) : _
  546.         Strng$ = CHR$(Char) _
  547.      ELSE Strng$ = INPUT$(1,3)
  548. 1421 IF ZErrCode = 57 THEN _
  549.         LineStatus = INP(ZLineStatusReg) : _
  550.         ZErrCode = 0 : _
  551.         GOTO 1420
  552.      END SUB
  553. 1479 ' $SUBTITLE: 'OpenRSeq  - open sequential file randomly'
  554. ' $PAGE
  555. '
  556. '  NAME    -- OpenRSeq
  557. '
  558. '  INPUTS  -- PARAMETER             MEANING
  559. '             FilName$      NAME OF SEQUENTIAL FILE TO OPEN AS #2
  560. '             RecLen        Length of a record
  561. '
  562. '  OUTPUTS -- NumRecs      NUMBER OF RECORDS IN THE FILE based on RecLen
  563. '             LenLastRec   NUMBER OF BYTES IN THE LAST RECORD
  564. '                          MAY BE LESS THAN OR EQUAL TO RecLen).
  565. '
  566. '  PURPOSE -- Open a sequential file as file #2 and read it randomly
  567. '
  568.      SUB OpenRSeq (FilName$,NumRecs,LenLastRec,RecLen) STATIC
  569.      ON ERROR GOTO 65000
  570. 1480 CALL OpenRand2 (FilName$,RecLen)
  571.      IF ZErrCode > 0 THEN _
  572.         EXIT SUB
  573.      FIELD #2, RecLen AS ZDnldRecord$
  574.      WasI# = LOF(2)
  575.      NumRecs = FIX(WasI#/RecLen)
  576.      LenLastRec = WasI# - CDBL(NumRecs) * RecLen
  577.      IF LenLastRec > 0 THEN _
  578.         NumRecs = NumRecs + 1 _
  579.      ELSE LenLastRec = RecLen
  580.      END SUB
  581. 1486 SUB OpenRand2 (FileToOpen$, FileLen) STATIC
  582.      ON ERROR GOTO 65000
  583.      CLOSE 2
  584. 1487 ZErrCode = 0
  585.      IF ZShareIt THEN _
  586.         OPEN FileToOpen$ FOR RANDOM SHARED AS #2 LEN=FileLen _
  587.      ELSE OPEN "R",2,FileToOpen$,FileLen
  588.      'IF ZErrCode = 52 OR ZErrCode = 54 THEN _
  589.      '   GOTO 1487
  590.      END SUB
  591. 9398 ' $SUBTITLE: 'OpenUser - subroutine to open users file as #5'
  592. ' $PAGE
  593. '
  594. '  NAME    -- OpenUser
  595. '
  596. '  INPUTS  --     PARAMETER                    MEANING
  597. '                 ZShareIt
  598. '
  599. '  OUTPUTS -- ZActiveUserFile$
  600. '             ZCityState$
  601. '             ZElapsedTime$
  602. '             ZLastDateTimeOn$
  603. '             LastRec                # OF Last RECORD IN USERS FILE
  604. '             ZListNewDate$
  605. '             ZPswd$
  606. '             ZSecLevel$
  607. '             ZUserDnlds$
  608. '             ZUserName$
  609. '             ZUserOption$
  610. '             ZUserRecord$
  611. '             ZUserUplds$
  612. '
  613. '  PURPOSE -- Open the user file as file #5
  614. '
  615.       SUB OpenUser (LastRec) STATIC
  616.       ON ERROR GOTO 65000
  617. '
  618. ' ****  OPEN AND DEFINE USER FILE RECORD VARIABLES  ****
  619. '
  620. 9400 CLOSE 5
  621.      IF ZShareIt THEN _
  622.         OPEN ZActiveUserFile$ FOR RANDOM SHARED AS #5 LEN=128 _
  623.      ELSE OPEN "R",5,ZActiveUserFile$,128
  624.      WasI# = LOF(5)
  625.      LastRec = FIX(WasI#/128)
  626.      FIELD 5,31 AS ZUserName$, _
  627.              15 AS ZPswd$, _
  628.               2 AS ZSecLevel$, _
  629.              14 AS ZUserOption$,  _
  630.              24 AS ZCityState$, _
  631.               3 AS MachineType$, _
  632.               4 AS ZTodayDl$, _
  633.               4 AS ZTodayBytes$, _
  634.               4 AS ZDlBytes$, _
  635.               4 AS ZULBytes$, _
  636.              14 AS ZLastDateTimeOn$, _
  637.               3 AS ZListNewDate$, _
  638.               2 AS ZUserDnlds$, _
  639.               2 AS ZUserUplds$, _
  640.               2 AS ZElapsedTime$
  641.      FIELD 5,128 AS ZUserRecord$
  642.      END SUB
  643. 12598 ' $SUBTITLE: 'FindUser - subroutine to search users file for a name'
  644. ' $PAGE
  645. '
  646. '  NAME    -- FindUser
  647. '
  648. '  INPUTS  --     PARAMETER                    MEANING
  649. '             HashToLookFor$        STRING TO SEARCH FOR IN USERS
  650. '             IndivToLookFor$       STRING TO USE TO INDIVIDUATE
  651. '                                   USERS WITH SAME HASH
  652. '             StartHashPos          WHERE HASH FIELD STARTS IN THE
  653. '                                  "USERS" FILE
  654. '             LenHashField          LENGTH OF THE HASH FIELD
  655. '             StartIndivPos         WHERE THE FIELD TO DISTINGUISH
  656. '                                   AMONG USERS (I.E. WITH THE SAME
  657. '                                   NAME) STARTS IN THE "USERS" FILE
  658. '                                   (SET TO 0 IF NONE TO BE USED)
  659. '             LenIndivField         LENGTH OF FIELD TO DISTINGUISH
  660. '                                   AMONG USERS
  661. '             MaxPosition           HIGHEST RECORD TO SEARCH OR USE
  662. '
  663. '  NOTE: THIS SUBROUTINE ASSUMES THE "USERS" FILE IS OPEN AS FILE 2.
  664. '
  665. '  OUTPUTS -- WhetherFound          SET TO "TRUE" IF USER WAS Found
  666. '                                   OTHERWISE IT IS "FALSE"
  667. '             PosToUse              NUMBER OF THE "USERS" RECORD THAT
  668. '                                   BELONGS TO THE USER (IF Found) OR
  669. '                                   TO USE FOR THE USER (IF THE USER
  670. '                                   WASN'T Found)
  671. '             PosToReclaim          SET TO 0 IF THE RECORD NUMBER
  672. '                                   SELECTED FOR THIS USER HAS NEVER
  673. '                                   BEEN USED.
  674. '
  675. '  PURPOSE -- To search the "USERS" file and determine the record
  676. '             number to use for the caller in the "USERS" file.
  677. '
  678.       SUB FindUser (HashToLookFor$,IndivToLookFor$,StartHashPos,_
  679.                     LenHashField,StartIndivPos,LenIndivField,_
  680.                     MaxPosition,WhetherFound,_
  681.                     PosToUse,PosToReclaim) STATIC
  682.       ON ERROR GOTO 65000
  683.       ZErrCode = 0
  684.       WhetherFound = 0
  685.       IF HashToLookFor$ = SPACE$(LEN(HashToLookFor$)) THEN _
  686.          EXIT SUB
  687.       EmptyRec$ = SPACE$(LenHashField)
  688.       EmptyIndiv$ = SPACE$(LenIndivField)
  689.       NewUser$ = LEFT$("NEWUSER  ",LenHashField + 2)
  690.       FIELD 5, 128 AS Filler$
  691.       WasX$ = HashToLookFor$ + SPACE$(LenHashField - LEN(HashToLookFor$))
  692.       CALL HashRBBS (HashToLookFor$,MaxPosition,PosToUse,ZWasDF)
  693. 12600 ZWasY$ = IndivToLookFor$ + SPACE$(LenIndivField - LEN(IndivToLookFor$))
  694.       PosToReclaim = 0
  695.       ZErrCode = 0
  696. 12610 GET 5,PosToUse
  697.       IF ZErrCode > 0 THEN _
  698.          IF ZErrCode = 63 THEN _
  699.             ZErrCode = 0 : _
  700.             GOTO 12621 _
  701.          ELSE ZErrCode = 0 : _
  702.               GOTO 12620
  703.       HashValue$ = MID$(Filler$,StartHashPos,LenHashField)
  704.       IF WasX$ = HashValue$ THEN _
  705.          IF StartIndivPos < 1 OR LenIndivField < 1 THEN _
  706.             WhetherFound = ZTrue : _
  707.             GOTO 12622 _
  708.          ELSE IndivValue$ = MID$(Filler$,StartIndivPos,LenIndivField) : _
  709.               IF ZWasY$ = IndivValue$ OR IndivValue$ = EmptyIndiv$ THEN _
  710.                  WhetherFound = ZTrue : _
  711.                  GOTO 12622
  712.       IF HashValue$ = EmptyRec$ THEN _
  713.          PosToUse = PosToReclaim - (PosToReclaim = 0) * PosToUse : _
  714.          WhetherFound = ZFalse : _
  715.          GOTO 12622
  716.       IF ASC(HashValue$) = 0 OR INSTR(HashValue$,NewUser$) = 1 THEN _
  717.          IF PosToReclaim = 0 THEN _
  718.             PosToReclaim = PosToUse
  719. 12620 PosToUse = PosToUse + ZWasDF
  720.       IF PosToUse > MaxPosition - 1 THEN _
  721.          PosToUse = PosToUse - MaxPosition
  722.       GOTO 12610
  723. 12621 IF PosToReclaim = 0 THEN _
  724.          PosToReclaim = PosToUse
  725.       GOTO 12620
  726. 12622 END SUB
  727. 13661 ' $SUBTITLE: 'UpdtCalr - subroutine to write to CALLERS file'
  728. ' $PAGE
  729. '
  730. '  NAME    -- UpdtCalr
  731. '
  732. '  INPUTS  --     PARAMETER                    MEANING
  733. '                 ErrMsg$                   MESSAGE TO GO IN CALLER LOG
  734. '                 EXTLog               = 1  CHECK FOR EXTENDED LOGGING
  735. '                                           BEFORE UPDATING.
  736. '                                      = 2  UPDATE CALLER LOG WITH ZWasZ$
  737. '                                      = 3  Time stamp before logging
  738. '
  739. '  OUTPUTS -- ZCurDate$           CURRENT DATE (MM-DD-YY)
  740. '             ZTime$                    CURRENT TIME (I.E. 1:13 PM)
  741. '             TIME.LOGGEND.ON$        TIME USER LOGGED ON (HH:MM:SS)
  742. '
  743. '  PURPOSE -- To update the caller's file and/or print on the
  744. '             local printer if it is enabled
  745. '
  746.       SUB UpdtCalr (ErrMsg$,EXTLog) STATIC
  747.       ON ERROR GOTO 65000
  748.       IF ZCallersFilePrefix$ = "" OR (ZLocalUser AND ZSysop) THEN _
  749.          EXIT SUB
  750.       WasX$ = "     " + ErrMsg$
  751. 13663 ZErrCode = 0
  752.       FIELD 4, 64 AS ZCallersRecord$
  753.       IF ZErrCode > 0 THEN _
  754.          CALL QuickTPut1 ("Caller's file:  error"+STR$(ZErrCode)) : _
  755.          ZErrCode = 0 : _
  756.          EXIT SUB
  757.       ON EXTLog GOTO 13665,13670,13667
  758. '
  759. ' ****  EXTENDED LOGGING ENTRY  ***
  760. '
  761. 13665 IF NOT ZExtendedLogging THEN _
  762.          EXIT SUB
  763. 13667 CALL AMorPM
  764.       WasX$ = WasX$ + " at " + ZTime$
  765. '
  766. ' ****  UPDATE CALLERS FILE WITH USER ACTIVITY  ****
  767. '
  768. 13670 LSET ZCallersRecord$ = WasX$
  769.       CALL Printit (ZCallersRecord$)
  770.       ZCallersFileIndex! = ZCallersFileIndex! + 1
  771. 13672 PUT 4,ZCallersFileIndex!
  772.       END SUB
  773. 13673 ' $SUBTITLE: 'Printit - subroutine to print on the local printer'
  774. ' $PAGE
  775. '
  776. '  NAME    -- Printit
  777. '
  778. '  INPUTS  --     PARAMETER                    MEANING
  779. '                 Strng$              STRING TO WRITE TO THE Printer
  780. '
  781. '  OUTPUTS -- NONE
  782. '
  783. '  PURPOSE -- To write to the printer attached to the pc running
  784. '             RBBS-PC and toggle the printer switch off whenever
  785. '             the printer is/becomes unavailable
  786. '
  787.       SUB Printit (Strng$) STATIC
  788.       ON ERROR GOTO 65000
  789. 13674 IF ZPrinter THEN _
  790.          LPRINT Strng$
  791.       END SUB
  792. 20101 ' $SUBTITLE: 'ChangeDir - subroutine to change subdirectories'
  793. ' $PAGE
  794. '
  795. '  NAME    -- ChangeDir
  796. '
  797. '  INPUTS  -- PARAMETER                    MEANING
  798. '             NewDir$                      NAME OF SUBDIRECTORY
  799. '
  800. '  OUTPUTS -- ZOK                           TRUE IF CHDIR SUCCESSFUL
  801. '             ZErrCode                      ERROR CODE
  802. '
  803. '  PURPOSE -- Change subdirectory
  804. '
  805.       SUB ChangeDir (NewDir$) STATIC
  806.       ON ERROR GOTO 65000
  807.       ZErrCode = 0
  808.       ZOK = ZTrue
  809. 20103 CHDIR NewDir$
  810.       END SUB
  811. 20219 ' $SUBTITLE: 'FINDITX - subroutine to find if a file exists'
  812. ' $PAGE
  813. '
  814. '  NAME    -- FINDITX
  815. '
  816. '  INPUTS  -- PARAMETER                    MEANING
  817. '             FilName$                 NAME OF FILE TO FIND
  818. '             FileNum                  # TO OPEN FILE AS
  819. '
  820. '  OUTPUTS -- ZOK                      TRUE IF FILE EXISTS
  821. '             ZErrCode                 ERROR CODE
  822. '
  823. '  PURPOSE -- Determine whether a file exists
  824. '
  825.       SUB FindItX (FilName$,FileNum) STATIC
  826.       ON ERROR GOTO 65000
  827.       ZErrCode = 0
  828.       ZOK = ZFalse
  829.       IF LEN(FilName$) < 1 THEN _
  830.          EXIT SUB
  831.       IF ZTurboRBBS THEN _
  832.          CALL FindFile (FilName$,ZOK) : _
  833.          IF ZOK THEN _
  834.             GOTO 20222 _
  835.          ELSE EXIT SUB
  836. 20221 CALL BadFileChar (FilName$,ZOK)
  837.       IF NOT ZOK THEN _
  838.          EXIT SUB
  839.       ZOK = ZFalse
  840.       NAME FilName$ AS FilName$
  841.       IF ZErrCode = 53 THEN _
  842.          ZErrCode = 0 : _
  843.          EXIT SUB
  844. 20222 CLOSE FileNum
  845. 20223 CALL OpenWork (FileNum,FilName$)
  846.       IF ZErrCode = 64 OR ZErrCode = 76 THEN _
  847.          ZOK = ZFalse : _
  848.          EXIT SUB
  849.       ZOK = ZTrue
  850.       END SUB
  851. 20308 ' $SUBTITLE: 'FlushCom -- subroutine reads all char. from  comm. port'
  852. ' $PAGE
  853. '
  854. '  NAME -- FlushCom
  855. '
  856. '  INPUTS --   PARAMETER     MEANING
  857. '              STrng$       STRING TO READ CHARACTERS INTO FROM
  858. '                           THE COMMUNICATIONS PORT (FILE #3)
  859. '
  860. '  OUTPUTS --   Strng$
  861. '
  862. '  PURPOSE -- Reads all characters from the communications port.
  863. '
  864.       SUB FlushCom (Strng$) STATIC
  865.       ON ERROR GOTO 65000
  866.       IF ZLocalUser THEN _
  867.          EXIT SUB
  868.       Strng$ = ""
  869.       IF NOT ZFossil THEN _
  870.          GOTO 20311
  871. 20310 CALL FosReadAhead(ZComPort,Char)
  872.       IF Char <> -1 THEN _
  873.          CALL FOSRXChar(ZComPort,Char) : _
  874.          Strng$ = Strng$ + CHR$(Char) : _
  875.          GOTO 20310
  876.       EXIT SUB
  877. 20311 Strng$ = INPUT$(LOC(3),3)                     ' FLUSH THE COMM BUFFER
  878. 20312 IF ZErrCode = 57 THEN _
  879.          LineStatus = INP(ZLineStatusReg) : _
  880.          ZErrCode = 0 : _
  881.          GOTO 20311
  882.       END SUB
  883. 20898 ' $SUBTITLE: 'NetBIOS - subroutine to lock/unlock using NetBIOS'
  884. ' $PAGE
  885. '
  886. '  NAME    -- NetBIOS   (WRITTEN BY DOUG AZZARITO)
  887. '
  888. '  INPUTS  -- IBMLockCmd       = 1-LOCK, 0-UNLOCK
  889. '             IBMFileLock      = 5 USERS FILE
  890. '                              = 6 SEMAPHORE FILE
  891. '             IBMRecLock       = RECORD NUMBER TO LOCK
  892. '
  893. '  OUTPUTS -- NONE
  894. '
  895. '  PURPOSE -- Lock and unlock files using NetBIOS commands.
  896. '             If lock fails, this routine tries forever.
  897. '
  898.       SUB NetBIOS (IBMLockCmd,IBMFileLock,IBMRecLock) STATIC
  899.       STATIC IBMCount
  900.       ON ERROR GOTO 65000
  901. 29900 ON IBMLockCmd + 1 GOTO 29920, 29910
  902.       EXIT SUB
  903. '
  904. ' *****  LOCK LOOP   ****
  905. '
  906. 29910 ZErrCode = 0
  907.       IF IBMFileLock = 6 AND IBMRecLock = 3 THEN _
  908.          IBMCount = IBMCount + 1 : _
  909.          IF IBMCount > 1 THEN _
  910.             EXIT SUB
  911.       LOCK IBMFileLock, IBMRecLock TO IBMRecLock
  912.       IF ZErrCode <> 0 THEN _
  913.          GOTO 29910
  914.       EXIT SUB
  915. 29920 ZErrCode = 0
  916.       IF IBMFileLock = 6 AND IBMRecLock = 3 THEN _
  917.          IBMCount = IBMCount - 1 : _
  918.          IF IBMCount > 0 THEN _
  919.             EXIT SUB _
  920.          ELSE IBMCount = 0
  921.       UNLOCK IBMFileLock, IBMRecLock TO IBMRecLock
  922.       IF ZErrCode = 70 THEN _
  923.          EXIT SUB
  924.       IF ZErrCode <> 0 THEN _
  925.          GOTO 29920
  926.       END SUB
  927. 43048 ' $SUBTITLE: 'UpdateC - update of callers log on exiting'
  928. ' $PAGE
  929. '
  930. '  NAME    -- UpdateC
  931. '
  932. '  INPUTS  --     PARAMETER                    MEANING
  933. '             ZCallersFileIndex!
  934. '             ZFirstName$
  935. '             ZWasHHH
  936. '             ZLastName$
  937. '             ZWasMMM
  938. '             ZWasNG$
  939. '             ZWasSSS
  940. '             ZSysopFirstName$
  941. '             ZSysopLastName$
  942. '
  943. '  OUTPUTS -- ZCallersRecord$
  944. '             ZCallersFileIndex!
  945. '             ZSysop
  946. '
  947. '  PURPOSE -- Update the callers file at logoff so that the number
  948. '             of hours, minutes, and seconds for the session are
  949. '             recorded as the last 9 characters of the 64-character
  950. '             callers file record
  951. '
  952.       SUB UpdateC STATIC
  953.       ON ERROR GOTO 65000
  954.       IF ZCallersFilePrefix$ = "" THEN _
  955.          EXIT SUB
  956. '
  957. ' ****  UPDATE CALLERS FILE AT LOGOFF  ***
  958. '
  959. 43050 FIELD 4,55 AS ZCallersRecord$,3 AS Hours$,3 AS Minutes$,3 AS Seconds$
  960.       LSET ZCallersRecord$ = MID$(ZWasNG$,65,55)
  961.       LSET Hours$ = STR$(ZSessionHour)
  962.       LSET Minutes$ = STR$(ZSessionMin)
  963.       LSET Seconds$ = STR$(ZSessionSec)
  964.       ZCallersFileIndex! = ZCallersFileIndex! + 1
  965.       PUT 4,ZCallersFileIndex!
  966.       FIELD 4,64 AS ZCallersRecord$
  967.       LSET ZCallersRecord$ = LEFT$(ZWasNG$,64)
  968.       ZCallersFileIndex! = ZCallersFileIndex! + 1
  969.       PUT 4,ZCallersFileIndex!
  970. 43060 LSET ZCallersRecord$ = STRING$(64,CHR$(0))
  971.       ZCallersFileIndex! = ZCallersFileIndex! + 1
  972.       PUT 4,ZCallersFileIndex!
  973.       ZCallersFileIndex! = ZCallersFileIndex! + 1
  974.       PUT 4,ZCallersFileIndex!
  975.       IF ZOrigCallers$ <> ZCallersFile$ THEN _
  976.          ZCallersFile$ = ZOrigCallers$ : _
  977.          CALL SetCall : _
  978.          GOTO 43050
  979.       END SUB
  980. 51098 ' $SUBTITLE: 'FindFree - subroutine to find space on a device'
  981. ' $PAGE
  982. '
  983. '  NAME    -- FindFree
  984. '
  985. '  INPUTS  --     PARAMETER                    MEANING
  986. '                 ZWasZ$                       NAME OF FILE TO FIND
  987. '
  988. '  OUTPUTS -- ZFreeSpace$                      NUMBER OF BYTES FREE
  989. '
  990. '  PURPOSE -- To determine amount of free space on a device
  991. '
  992.       SUB FindFree STATIC
  993.       ON ERROR GOTO 65000
  994.       ZErrCode = 0
  995. 52000 IF ZTurboRBBS THEN _
  996.          GOTO 52003
  997.       ZFreeSpace$ = ""
  998.       CLS
  999.       ZErrCode = 0
  1000. 52001 FILES ZWasZ$
  1001.       IF ZErrCode = 53 AND (ZWasZ$ = ZCmntsFile$ OR ZWasZ$ = ZUpldDriveFile$ ) THEN _
  1002.          CALL OpenOutW (ZWasZ$) : _
  1003.          GOTO 52000
  1004.       IF ZErrCode = 53 AND ZWasZ$ = ZUpldDir$ THEN _
  1005.          ZOutTxt$ = "Upload directory missing.  Tell SysOp" : _
  1006.          ZSubParm = 6 : _
  1007.          CALL TPut : _
  1008.          GOTO 52002
  1009.       FOR WasX = 1 TO 25
  1010.          ZFreeSpace$ = ZFreeSpace$ + CHR$(SCREEN (3,WasX))
  1011.       NEXT
  1012. 52002 ZSubParm = 1
  1013.       CALL Line25
  1014.       EXIT SUB
  1015. 52003 WasAX = 0
  1016.       WasBX = 0
  1017.       WasCX = 0
  1018.       WasDX = 0
  1019.       IF MID$(ZWasZ$,2,1) = ":" THEN _
  1020.          WasAX = ASC(ZWasZ$) - ASC("A") + 1
  1021.       CALL RBBSFree (WasAX,WasBX,WasCX,WasDX)
  1022.       WasI# = CDBL(WasAX) * (WasBX + 65536! * (-(WasBX < 0)))
  1023.       WasI# = WasI# * WasCX
  1024.       ZFreeSpace$ = STR$(WasI#) + _
  1025.                     " bytes free"
  1026.       END SUB
  1027. 57978 ' $SUBTITLE: 'OpenWork - subroutine to open RBBS-PC's work file (2)'
  1028. ' $PAGE
  1029. '
  1030. '  NAME   -- OpenWork
  1031. '
  1032. '  INPUTS --     PARAMETER                    MEANING
  1033. '                FileNum                    # OF FILE TO OPEN AS
  1034. '                FilName$                   NAME OF FILE TO FIND
  1035. '                ZShareIt                   USE DOS' "SHARE" FACILITIES
  1036. '
  1037. '  OUTPUTS -- ZErrCode                        ERROR CODE
  1038. '
  1039. '  PURPOSE -- To open RBBS-PC's "work" file (number 2)
  1040. '
  1041.       SUB OpenWork (FileNum,FilName$) STATIC
  1042.       ON ERROR GOTO 65000
  1043. 58000 CLOSE FileNum
  1044. 58010 ZErrCode = 0
  1045. 58020 IF ZShareIt THEN _
  1046.          OPEN FilName$ FOR INPUT SHARED AS #FileNum _
  1047.       ELSE OPEN "I",FileNum,FilName$
  1048.       IF ZErrCode = 52 THEN _
  1049.          GOTO 58010
  1050. 58030 END SUB
  1051. 58190 ' $SUBTITLE: 'OpenFMS - subroutine to open the FMS directory'
  1052. ' $PAGE
  1053. '
  1054. '  NAME    -- OpenFMS
  1055. '
  1056. '  INPUTS  -- PARAMETER                      MEANING
  1057. '             ZShareIt                DOS SHARING FLAG
  1058. '             ZFMSDirectory$          NAME OF FMS DIRECTORY
  1059. '
  1060. '  OUTPUTS -- LastRec                NUMBER OF THE Last
  1061. '                                    RECORD IN THE FILE
  1062. '
  1063. '  PURPOSE -- To open the upload directory as a random file and find
  1064. '             the number of the last record in the file.
  1065. '
  1066.       SUB OpenFMS (LastRec) STATIC
  1067.       ON ERROR GOTO 65000
  1068.       FileLength = 38 + ZMaxDescLen
  1069.       CLOSE 2
  1070.       IF ZActiveFMSDir$ = "" THEN _
  1071.          IF ZMenuIndex = 6 THEN _
  1072.             ZActiveFMSDir$ = ZLibDir$ _
  1073.          ELSE ZActiveFMSDir$ = ZFMSDirectory$
  1074.       ZErrCode = 0
  1075.       IF ZShareIt THEN _
  1076.          OPEN ZActiveFMSDir$ FOR RANDOM SHARED AS #2 LEN=FileLength _
  1077.       ELSE OPEN "R",2,ZActiveFMSDir$,FileLength
  1078.       IF ZErrCode > 0 THEN _
  1079.          CALL QuickTPut1 ("Drive/path does not exist or bad name for FMS dir " + _
  1080.                      ZActiveFMSDir$) : _
  1081.          END
  1082.       LastRec = LOF(2)/FileLength
  1083.       IF ZActiveFMSDir$ = PrevFMS$ THEN _
  1084.          EXIT SUB
  1085.       PrevFMS$ = ZActiveFMSDir$
  1086.       FIELD 2, FileLength AS FMSRec$
  1087.       GET #2,1
  1088.       ZWasA = (LEFT$(FMSRec$,4) <> "\FMS")
  1089.       ZUpInc = 2*(INSTR(FMSRec$," TOP ") = 0 OR ZWasA) + 1
  1090.       ZDateOrderedFMS = ZWasA OR (INSTR(FMSRec$," NOSORT") = 0)
  1091.       ZWasDF = INSTR(FMSRec$,"CH(")
  1092.       ZChainedDir$ = ""
  1093.       IF ZWasDF > 0 AND (NOT ZWasA) THEN _
  1094.          WasX = INSTR(ZWasDF,FMSRec$,")") : _
  1095.          IF WasX > 0 THEN _
  1096.             ZChainedDir$ = MID$(FMSRec$,ZWasDF+3,WasX-ZWasDF-3) : _
  1097.             CALL FindFile (ZChainedDir$,ZOK) : _
  1098.             IF NOT ZOK THEN _
  1099.                ZChainedDir$ = ""
  1100.       END SUB
  1101. 58220 ' $SUBTITLE: 'OpenOutW - sub to open output work file (2)'
  1102. ' $PAGE
  1103. '
  1104. '  NAME    -- OpenOutW
  1105. '
  1106. '  INPUTS  --     PARAMETER                 MEANING
  1107. '                 ZFileName$            NAME OF FILE TO FIND
  1108. '                 ZShareIt              USE DOS' "SHARE" FACILITIES
  1109. '
  1110. '  OUTPUTS -- ZErrCode                        ERROR CODE
  1111. '
  1112. '  PURPOSE -- To open RBBS-PC's "work" file (number 2) for output
  1113. '
  1114.       SUB OpenOutW (FilName$) STATIC
  1115.       ON ERROR GOTO 65000
  1116.       CLOSE 2
  1117. 58225 ZErrCode = 0
  1118. 58230 IF ZShareIt THEN _
  1119.          OPEN FilName$ FOR OUTPUT SHARED AS #2 _
  1120.       ELSE OPEN "O",2,FilName$
  1121. 58235 END SUB
  1122. 58260 ' $SUBTITLE: 'KillWork - subroutine to delete a "work" file'
  1123. ' $PAGE
  1124. '
  1125. '  NAME    -- KillWork
  1126. '
  1127. '  INPUTS  --     PARAMETER                    MEANING
  1128. '                 FilName$                  NAME OF FILE TO DELETE
  1129. '
  1130. '  OUTPUTS -- ZErrCode                        ERROR CODE
  1131. '
  1132. '  SUBROUTINE PURPOSE -- To delete a RBBS-PC "work" file
  1133. '
  1134.       SUB KillWork (FilName$) STATIC
  1135.       ON ERROR GOTO 65000
  1136.       CLOSE 2
  1137.       ZErrCode = 0
  1138. 58270 KILL FilName$
  1139. 58275 END SUB
  1140. 58280 ' $SUBTITLE: 'GetPassword - sub to read the "passwords" file'
  1141. ' $PAGE
  1142. '
  1143. '  NAME    -- GetPassword
  1144. '
  1145. '                          PARAMETER             MEANING
  1146. '  INPUTS  -- FILE # 2 OPENED
  1147. '
  1148. '  OUTPUTS -- ZTempPassword$
  1149. '             ZTempSecLevel
  1150. '             ZTempTimeAllowed
  1151. '             ZTempRegPeriod
  1152. '             ZTempMaxPerDay
  1153. '
  1154. '  PURPOSE -- To read the RBBS-PC "PASSWORDS" file
  1155. '
  1156.       SUB GetPassword STATIC
  1157.       ON ERROR GOTO 65000
  1158.       ZErrCode = 0
  1159.       INPUT #2,ZTempPassword$,     ZTempSecLevel, _
  1160.                ZTempTimeAllowed,  ZTempMaxPerDay, _
  1161.                ZTempRegPeriod,    ZStartTime, _
  1162.                ZEndTime,           ZByteMethod, _
  1163.                ZRatioRestrict#, ZInitialCredit#, _
  1164.                ZTempTimeLock
  1165. 58285 END SUB
  1166. 58290 ' $SUBTITLE: 'ReadDir - subroutine to read the "DIR" files'
  1167. ' $PAGE
  1168. '
  1169. '  NAME    -- ReadDir
  1170. '
  1171. '             PARAMETER                MEANING
  1172. '  INPUTS  -- FileNum                  WHICH # FILE TO READ
  1173. '             WhichLine                HOW MANY LINES TO ADVANCE
  1174. '
  1175. '  OUTPUTS -- ZOutTxt$
  1176. '
  1177. '  PURPOSE -- To read possible "DIR" files
  1178. '
  1179.       SUB ReadDir (FileNum,WhichLine) STATIC
  1180.       ON ERROR GOTO 65000
  1181.       ZErrCode = 0
  1182.       FOR WasI = 1 TO WhichLine
  1183.          LINE INPUT #FileNum,ZOutTxt$
  1184.       NEXT
  1185. 58295 END SUB
  1186. 58300 ' $SUBTITLE: 'ReadParms - subroutine to read parameter values'
  1187. ' $PAGE
  1188. '
  1189. '  NAME    -- ReadParms
  1190. '
  1191. '               PARAMETER             MEANING
  1192. '  INPUTS  -- FILE # 2 OPENED
  1193. '             NumParms               # parameters to read
  1194. '             WhichLine              Which set of parms to return
  1195. '  OUTPUTS -- ARA.TO.USER$           Array of string values
  1196. '             FILE.SECURITY
  1197. '             FilePswd$
  1198. '
  1199. '  PURPOSE -- To read different values, where values are
  1200. '             separated by a comma or carriage-return-line-feed.
  1201. '
  1202.       SUB ReadParms (AraToUse$(1),NumParms,WhichLine) STATIC
  1203.       ON ERROR GOTO 65000
  1204.       ZErrCode = 0
  1205.       FOR WasJ = 1 TO WhichLine
  1206.          FOR WasI = 1 TO NumParms
  1207.             INPUT #2,AraToUse$(WasI)
  1208.          NEXT
  1209.       NEXT
  1210. 58305 END SUB
  1211. 58310 ' $SUBTITLE: 'ReadAny - subroutine to read file 2 into ZOutTxt$'
  1212. ' $PAGE
  1213. '
  1214. '  NAME    -- ReadAny
  1215. '
  1216. '               PARAMETER             MEANING
  1217. '  INPUTS  -- FILE # 2 OPENED
  1218. '
  1219. '  OUTPUTS -- ZOutTxt$
  1220. '
  1221. '  PURPOSE -- To read file #2 into ZOutTxt$
  1222. '
  1223.       SUB ReadAny STATIC
  1224.       ON ERROR GOTO 65000
  1225.       ZErrCode = 0
  1226.       INPUT #2,ZOutTxt$
  1227. 58315 END SUB
  1228. 58320 ' $SUBTITLE: 'PrintWork - subroutine to print to file 2'
  1229. ' $PAGE
  1230. '
  1231. '  NAME    -- PrintWork
  1232. '
  1233. '               PARAMETER             MEANING
  1234. '  INPUTS  -- FILE # 2 OPENED
  1235. '             STRING TO WRITE OUT
  1236. '
  1237. '  OUTPUTS -- NONE
  1238. '
  1239. '  PURPOSE -- To print a string to file #2
  1240. '
  1241.       SUB PrintWork (Strng$) STATIC
  1242.       ON ERROR GOTO 65000
  1243.       ZErrCode = 0
  1244.       PRINT #2,Strng$;
  1245. 58325 END SUB
  1246. 58330 ' $SUBTITLE: 'GetWork - subroutine to read file 2'
  1247. ' $PAGE
  1248. '
  1249. '  NAME    -- GetWork
  1250. '
  1251. '               PARAMETER             MEANING
  1252. '  INPUTS  -- RecLen            Length of record
  1253. '
  1254. '  OUTPUTS -- NONE
  1255. '
  1256. '  PURPOSE -- To read a record from file #2
  1257. '
  1258.       SUB GetWork (RecLen) STATIC
  1259.       ON ERROR GOTO 65000
  1260.       ZErrCode = 0
  1261.       FIELD 2, RecLen AS ZDnldRecord$
  1262.       GET 2,(LOC(2)+1)
  1263. 58335 END SUB
  1264. 58340 ' $SUBTITLE: 'OpenWorkA - subroutine to open output work file (2)'
  1265. ' $PAGE
  1266. '
  1267. '  NAME    -- OpenWorkA
  1268. '
  1269. '  INPUTS  --     PARAMETER                    MEANING
  1270. '              FilName$                  NAME OF FILE TO FIND
  1271. '              ZShareIt                  USE DOS' "SHARE" FACILITIES
  1272. '
  1273. '  OUTPUTS -- ZErrCode                        ERROR CODE
  1274. '
  1275. '  PURPOSE -- To open RBBS-PC's "work" file (number 2) for appended output
  1276. '
  1277.       SUB OpenWorkA (FilName$) STATIC
  1278.       ON ERROR GOTO 65000
  1279.       CLOSE 2
  1280.       ZErrCode = 0
  1281.       IF ZShareIt THEN _
  1282.          OPEN FilName$ FOR APPEND SHARED AS #2 _
  1283.       ELSE OPEN "A",2,FilName$
  1284. 58345 END SUB
  1285. 58350 ' $SUBTITLE: 'PrintWorkA - subroutine to print to file 2 with CR'
  1286. ' $PAGE
  1287. '
  1288. '  NAME    -- PrintWorkA
  1289. '
  1290. '                          PARAMETER             MEANING
  1291. '  INPUTS  --            FILE # 2 OPENED
  1292. '                        STRING TO WRITE OUT
  1293. '
  1294. '  OUTPUTS -- NONE
  1295. '
  1296. '  PURPOSE -- To print a string to file #2 followed by a carriage return
  1297. '
  1298.       SUB PrintWorkA (Strng$) STATIC
  1299.       ON ERROR GOTO 65000
  1300.       ZErrCode = 0
  1301.       PRINT #2,Strng$
  1302. 58355 END SUB
  1303. 58360 ' $SUBTITLE: 'CheckInt - subroutine to check input is an integer'
  1304. ' $PAGE
  1305. '
  1306. '  NAME    -- CheckInt
  1307. '
  1308. '             PARAMETER             MEANING
  1309. '  INPUTS  -- Strng$         STRING TO VERIFY CAN BE AN INTEGER
  1310. '
  1311. '  OUTPUTS -- ZErrCode             = 0 MEANS IT IS AN INTEGER VALUE
  1312. '                                 <> 0 MEANS IT IS NOT AN INTEGER VALUE
  1313. '             ZTestedIntValue  Integer value of expression
  1314. '
  1315. '  PURPOSE -- To validate that a string represents an integer
  1316. '
  1317.       SUB CheckInt (Strng$) STATIC
  1318.       ON ERROR GOTO 65000
  1319.       ZErrCode = 0
  1320.       WasX$ = Strng$
  1321.       CALL Trim (WasX$)
  1322.       ZTestedIntValue = VAL(LEFT$(WasX$,INSTR(WasX$+" "," ")-1))
  1323. 58365 END SUB
  1324. 59650 ' $SUBTITLE: 'PutCom -- subroutine to write to communications port'
  1325. ' $PAGE
  1326. '
  1327. '  NAME    --  PutCom
  1328. '
  1329. '  INPUTS  --   PARAMETER     MEANING
  1330. '                STRNG$       STRING TO PRINT TO COMM PORT
  1331. '              ZFlowControl  WHETHER USING CLEAR TO SEND FOR FLOW
  1332. '                            CONTROL BETWEEN THE PC AND THE MODEM
  1333. '
  1334. '  OUTPUTS --
  1335. '
  1336. '  PURPOSE -- Checks for carrier drop and flow control (xon/xoff)
  1337. '             before writing to the communications port.
  1338. '
  1339.       SUB PutCom (Strng$) STATIC
  1340.       ON ERROR GOTO 65000
  1341.       IF ZLocalUser THEN _
  1342.          EXIT SUB
  1343.       CALL CheckCarrier
  1344.       IF ZSubParm = -1 THEN _
  1345.          EXIT SUB
  1346.       IF NOT ZXOffEd THEN _
  1347.          GOTO 59652
  1348.       ZSubParm = 1
  1349.       CALL Line25
  1350.       ZWasY$ = ZXOff$
  1351.       XOffTimeout! = TIMER + ZWaitBeforeDisconnect
  1352.       WHILE ZWasY$ = ZXOff$ AND ZSubParm <> -1
  1353.          Char = -1
  1354.          WHILE Char = -1 AND ZSubParm <> -1
  1355.             GOSUB 59654
  1356.          WEND
  1357.          IF Char <> -1 THEN _
  1358.             CALL GetCom(ZWasY$) : _
  1359.             IF ZXOnXOff AND ZWasY$ <> ZXOn$ THEN _
  1360.                ZWasY$ = ZXOff$
  1361.       WEND
  1362.       ZXOffEd = ZFalse
  1363.       ZSubParm = 1
  1364.       CALL Line25
  1365. 59652 ZNotCTS = ZFalse
  1366.       IF NOT ZFossil THEN _
  1367.          PRINT #3,Strng$; : _
  1368.          EXIT SUB
  1369.       IF Strng$ = "" THEN _
  1370.          EXIT SUB
  1371.       FOR WasN = 1 TO LEN(Strng$)
  1372.           Char = ASC(MID$(Strng$,WasN,1))
  1373. 59653     CALL FosTXCharNW(ZComPort,Char,Result)
  1374.           IF Result = 0 THEN _
  1375.              CALL GoIdle : _
  1376.              GOTO 59653
  1377.       NEXT
  1378.       EXIT SUB
  1379. 59654 CALL EofComm (Char)
  1380.       CALL GoIdle
  1381.       CALL CheckCarrier
  1382.       CALL CheckTime(XOffTimeout!, TempElapsed!,1)
  1383.       IF ZSubParm = 2 THEN _
  1384.          ZSubParm = -1
  1385.       RETURN
  1386.       END SUB
  1387. 59660 ' $SUBTITLE: 'PutWork -- subroutine to write to upload files'
  1388. ' $PAGE
  1389. '
  1390. '  NAME    -- PutWork
  1391. '
  1392. '  INPUTS  --   PARAMETER     MEANING
  1393. '                STNG$       STRING TO WRITE TO FILE
  1394. '                RecNum      RECORD NUMBER TO WRITE
  1395. '                RecLen      LENGTH OF RECORD TO WRITE
  1396. '
  1397. '  OUTPUTS --
  1398. '
  1399. '  PURPOSE -- Writes uploaded file records to work file
  1400. '
  1401.       SUB PutWork (Strng$,RecNum,RecLen) STATIC
  1402.       ON ERROR GOTO 65000
  1403.       FIELD #2,RecLen AS ZUpldRec$
  1404.       LSET ZUpldRec$ = Strng$
  1405.       RecNum = RecNum + 1
  1406.       PUT #2,RecNum
  1407.       END SUB
  1408. 59680 ' $SUBTITLE: 'RBBSPlay -- subroutine to play music'
  1409. ' $PAGE
  1410. '
  1411. '  NAME    -- RBBSPlay
  1412. '
  1413. '  INPUTS  --   PARAMETER     MEANING
  1414. '               Strng$      STRING TO PLAY
  1415. '
  1416. '  OUTPUTS --
  1417. '
  1418. '  PURPOSE -- Play music.  Skip if get an error.
  1419. '
  1420.       SUB RBBSPlay (StringToPlay$) STATIC
  1421.       PLAY StringToPlay$
  1422.       ZErrCode = 0
  1423.       END SUB
  1424. 59700 ' $SUBTITLE: 'Talk -- subroutine for voice response'
  1425. ' $PAGE
  1426. '
  1427. '  NAME    -- Talk
  1428. '
  1429. '  INPUTS  --   PARAMETER     MEANING
  1430. '               ZVoiceType    TYPE OF VOICE SYNTHESIZER
  1431. '               VoiceRecord   RECORD NUMBER TO RETRIEVE
  1432. '
  1433. '  OUTPUTS --
  1434. '
  1435. '  PURPOSE -- Retrieve voice record and send to voice synthesizer
  1436. '
  1437.       SUB Talk (VoiceRecord,StringWork$) STATIC
  1438.       IF ZVoiceType = 0 THEN _
  1439.          EXIT SUB
  1440.       IF VoiceRecord > 0 THEN _
  1441.          GOTO 59720
  1442.       CLOSE 9,8
  1443.       IF ZVoiceType = 1 THEN _
  1444.          OPEN "COM2:2400,E,7,1,CS65535" AS #9 : _
  1445.          LPRINT "OPENED COM PORT"
  1446.       IF ZShareIt THEN _
  1447.          OPEN "RBBSTALK.DEF" FOR RANDOM SHARED AS #8 LEN=32 _
  1448.       ELSE OPEN "R",8,"RBBSTALK.DEF",32
  1449.       FIELD 8,30 AS TalkRecord$,2 AS Dummy$
  1450.       EXIT SUB
  1451. 59720 IF NOT ZSnoop THEN _
  1452.          EXIT SUB
  1453.       IF VoiceRecord < 65 THEN _
  1454.          GET 8,VoiceRecord : _
  1455.          StringWork$ = TalkRecord$ : _
  1456.          CALL Trim (StringWork$)
  1457. 59721 IF ZSmartTextCode THEN _
  1458.          CALL SmartText (StringWork$, CRFound,ZFalse)
  1459. 59722 IF ZVoiceType = 1 THEN _
  1460.          PRINT #9,StringWork$
  1461. 59723 IF ZVoiceType = 2 THEN _
  1462.          CALL RBBSHS (CHR$(LEN(StringWork$)+1)+StringWork$+CHR$(13))
  1463.       END SUB
  1464. 59725 ' $SUBTITLE: 'CommPut -- Writes to communications port'
  1465. ' $PAGE
  1466. '
  1467. '  NAME    -- CommPut
  1468. '
  1469. '  INPUTS  --   PARAMETER     MEANING
  1470. '               Strng$        String to write
  1471. '               ZFossil       Whether using Fossil driver
  1472. '
  1473. '  OUTPUTS --
  1474. '
  1475. '  PURPOSE -- Send string to comm port.  Recovers from errors.
  1476. '
  1477.       SUB CommPut (Strng$) STATIC
  1478.       ON ERROR GOTO 65000
  1479.       IF ZFossil THEN _
  1480.          Bytes = LEN(Strng$) : _
  1481.          CALL FosWrite(ZComPort,Bytes,Strng$) _
  1482.       ELSE PRINT #3,Strng$;
  1483.       END SUB
  1484. 59790 ' $SUBTITLE: 'FindFile -- subroutine to find a file'
  1485. ' $PAGE
  1486. '
  1487. '  NAME    --  FindFile
  1488. '
  1489. '  INPUTS  --  PARAMETER         MENANING
  1490. '               FilName$         NAME OF FILE TO LOOK FOR
  1491. '               FExists          WHETHER FILE EXISTS
  1492. '
  1493. '  OUTPUTS --  RETURNED.VALUE    VALUE RETURNED
  1494. '                                TRUE  = FILE EXISTS
  1495. '                                TRUE = FILE DOES NOT EXIST
  1496. '
  1497. '  PURPOSE --  Determine whether passed file FilName$ exists
  1498. '              Unlike, FindIt, this routine does not open any
  1499. '              file and, hence, does not create one in determining
  1500. '              whether a file exists.
  1501. '
  1502.       SUB FindFile (FilName$,FExists) STATIC
  1503.       CALL BadFileChar (FilName$,FExists)
  1504. 59791 IF FExists THEN _
  1505.          IOErrorCount = 0 : _
  1506.          CALL RBBSFind (FilName$,WasZ,WasY,WasM,WasD) : _
  1507.          FExists = (WasZ = 0)
  1508.       END SUB
  1509. '  $SUBTITLE: 'Error Handling for separately compiled subroutines'
  1510. '  $PAGE
  1511. '
  1512. '
  1513. ' Error handling for the separately compiled subroutines of RBBS-PC
  1514. '
  1515. '
  1516. 65000 IF ZDebug THEN _
  1517.          ZOutTxt$ = "RBBSSUB1 DEBUG Error Trap Entry ERL=" + _
  1518.               STR$(ERL) + _
  1519.               " ERR=" + _
  1520.               STR$(ERR) : _
  1521.          IF ZPrinter THEN _
  1522.             CALL Printit(ZOutTxt$) _
  1523.          ELSE CALL LPrnt(ZOutTxt$,1)
  1524.       ZErrCode = ERR
  1525. '
  1526. '     SetCall
  1527. '
  1528.       IF ERL = 108 THEN _
  1529.          CALL PScrn ("Unable to create callers log " + ZCallersFile$) : _
  1530.          SYSTEM
  1531.       IF ERL = 110 THEN _
  1532.           RESUME NEXT
  1533. '
  1534. '     OPEN CONFIG FILE
  1535. '
  1536.        IF ERL => 117 AND ERL <= 119 THEN _
  1537.           RESUME NEXT
  1538. '
  1539. '     OPEN COM PORT ERROR HANDLING
  1540. '
  1541.       IF ERL = 200 THEN _
  1542.          CLS : _
  1543.          CALL PScrn (ZComPort$ + " does not exist/not responding- Error" + STR$(ERR)) : _
  1544.          STOP
  1545. '
  1546. '     GetCom ERROR HANDLING
  1547. '
  1548.        IF ERL = 1420 AND ERR = 57 THEN _
  1549.           RESUME NEXT
  1550.        IF ERL = 1420 AND ERR = 69 THEN _
  1551.           ZSubParm = -1 :_
  1552.           RESUME NEXT
  1553. '
  1554. '      OPENRESEQ ERROR HANDLING
  1555. '
  1556.        IF ERL = 1487 THEN _
  1557.            ZErrCode = ERR : _
  1558.            RESUME NEXT
  1559. '
  1560. '      OpenUser ERROR HANDLING
  1561. '
  1562.        IF ERL = 9400 AND ERR = 75 AND ZShareIt THEN _
  1563.           CALL DelayTime (30) : _
  1564.           RESUME
  1565. '
  1566. '      FindUser ERROR HANDLING
  1567. '
  1568.        IF ERL = 12610 OR ERL = 12600 THEN _
  1569.           RESUME NEXT
  1570. '
  1571. '     UpdtCalr ERROR HANDLING
  1572. '
  1573.        IF ERL = 13663 THEN _
  1574.           RESUME NEXT
  1575.        IF ERL = 13672 AND ERR = 61 THEN _
  1576.           CALL QuickTPut1 ("Disk Full") : _
  1577.           IF ZDiskFullGoOffline THEN _
  1578.              GOTO 65010 _
  1579.           ELSE RESUME NEXT
  1580.        IF ERL = 13672 THEN _
  1581.           ZCallersFileIndex! = ZCallersFileIndex! - 1 : _
  1582.           RESUME NEXT
  1583. '
  1584. '     ZPrinter ERROR HANDLING
  1585. '
  1586.        IF ERL = 13674 THEN _
  1587.           ZPrinter = ZFalse : _
  1588.           RESUME
  1589. '
  1590. '      ChangeDir ERROR HANDLING
  1591. '
  1592.        IF ERL = 20103 THEN _
  1593.           ZOK = ZFalse : _
  1594.           RESUME NEXT
  1595. '
  1596. '     FindIt ERROR HANDLING
  1597. '
  1598.        IF ERL = 20221 THEN _
  1599.           RESUME NEXT
  1600.        IF ERL = 20223 AND ZErrCode = 58 THEN _
  1601.           ZErrCode = 64 : _
  1602.           ZOK = ZFalse : _
  1603.           RESUME NEXT
  1604.        IF ERL = 20223 AND ZErrCode = 76 THEN _
  1605.           CALL LPrnt("Bad path.  File name is " + FilName$,1) : _
  1606.           ZErrCode = 76 : _
  1607.           ZOK = ZFalse : _
  1608.           RESUME NEXT
  1609.        IF ERL => 20221 AND ERL <= 20223 AND ZErrCode = 70 _
  1610.           AND ZNetworkType = 6 THEN _
  1611.              ZErrCode = 0 : _
  1612.              RESUME NEXT
  1613.        IF ERL => 20221 AND ERL <= 20223 THEN _
  1614.           RESUME
  1615. '
  1616. '     FlushCom ERROR HANDLING
  1617. '
  1618.        IF ERL = 20311 AND ERR = 57 THEN _
  1619.           RESUME NEXT
  1620.        IF ERL = 20311 AND ERR = 69 THEN _
  1621.           ZAbort = ZTrue : _
  1622.           ZSubParm = -1 : _
  1623.           RESUME NEXT
  1624. '
  1625. '     NetBIOS ERROR HANDLING
  1626. '
  1627.        IF ERL => 29900 AND ERL <= 29920 THEN _
  1628.           RESUME NEXT
  1629. '
  1630. '     UpdateC ERROR HANDLING
  1631. '
  1632.       IF ERL => 43050 AND ERL <= 43060 AND ERR = 61 THEN _
  1633.          ZOutTxt$ = "* Disk full - terminating *" : _
  1634.          ZSubParm =2 : _
  1635.          CALL TPut : _
  1636.          IF ZDiskFullGoOffline THEN _
  1637.            GOTO 65010 _
  1638.          ELSE SYSTEM
  1639. '
  1640. '     CheckInt ERROR HANDLING
  1641. '
  1642.        IF (ERL = 59652 OR ERL = 59727) AND ERR = 24 THEN _
  1643.           ZNotCTS = ZTrue : _
  1644.           CALL Line25 : _
  1645.           ZErrCode = 0 : _
  1646.           RESUME
  1647.        IF ERL => 52000 AND ERL <= 59725 THEN _
  1648.           RESUME NEXT
  1649. '
  1650. '     FindFile ERROR HANDLING
  1651. '
  1652.        IF ERL = 59791 THEN _
  1653.           IF ERR = 57 THEN _
  1654.              CALL DelayTime (1) : _
  1655.              CALL UpdtCalr ("SLOW I/O ERROR",1) : _
  1656.              IOErrorCount = IOErrorCount + 1 : _
  1657.              IF IOErrorCount < 11 THEN _
  1658.                 RESUME
  1659. '
  1660. '     CATCH ALL OTHER ERRORS
  1661. '
  1662.        ZOutTxt$ = "RBBS-SUB1 Untrapped Error" + _
  1663.             STR$(ERR) + _
  1664.             " in line" + _
  1665.             STR$(ERL)
  1666.        CALL QuickTPut1 (ZOutTxt$)
  1667.        CALL UpdtCalr (ZOutTxt$,2)
  1668.        RESUME NEXT
  1669. '     SHARED ROUTINE FOR GOING OFF LINE WHEN DISK FULL
  1670. 65010  CALL OpenCom(ZModemInitBaud$,",N,8,1")
  1671.        CALL TakeOffHook
  1672.        IF ZFossil THEN _
  1673.           CALL FOSExit(ZComPort)
  1674.        SYSTEM
  1675.